Shareware Grab Bag/Shareware Grab Bag.iso/090/cmln1286.arc/BNCHMARK.ADA/DHRYSTON.ADA

Text File | 1986-10-20 | 13KB | 436 lines

---------------------------------------------------------------------------
--                      "DHRYSTONE Benchmark Program"
--                      -----------------------------
--
--
--      Version: ADA/1
--
--      Date:    04/15/84
--
--      Author:  Reinhold P Weicker
--
--      Taken from the October 1984 issue of the Communications of the ACM.
--      Source available from Mark Petersen's Alpo-Net FIDO board at
--      [phone], 300/1200/2400 8,N,1
--
--------------------------------------------------------------------------------
--
--The following program contains statements of a high-level programing
--language (ADA) in a distribution considered representative:
--
--
--  assignments                 53%
--  control statements          32%
--  procedure function calls    15%
--
--
--100 statements are dynamically executed. The program is balanced with
--respect to the three aspects:
--
--
--  -statement type
--  -operand type (for simple data types)
--  -operand access
--      operand global, local, parameter, or constant.
--
--The combination of these three aspects is balanced only approximately.
--
--The program does not compute anything meaningful, but it is syntactically
--and semantically correct. All variables have a value assigned to them
--before they are used as a source operand.

PACKAGE GLOBAL_DEF IS

  -- Global type definitions

type Enumeration is (Ident_1, Ident_2, Ident_3, Ident_4, Ident_5);

subtype One_To_Thirty is integer range 1..30;
subtype One_To_Fifty is integer range 1..50;
subtype Capital_Letter is character range 'A'..'Z';

type String_30 is array (One_To_Thirty) of character;
  pragma Pack (String_30);

type Array_1_Dim_Integer is array(One_To_Fifty)of integer;
type Array_2_Dim_Integer is array(One_To_Fifty,
                                  One_To_Fifty)of integer;

type Record_Type(Discr:Enumeration:=Ident_1);

type Record_Pointer is access Record_Type;

type Record_Type (Discr:Enumeration:=Ident_1)is
    record
      Pointer_Comp:       Record_Pointer;

      case Discr is
      when Ident_1=>      -- only this variant is used,
                          -- but in some cases discriminant
                          -- checks are necessary

       Enum_Comp:        Enumeration;
       Int_Comp:         One_To_Fifty;
       String_Comp:      String_30;
     when Ident_2=>
       Enum_Comp_2:      Enumeration;
       String_comp_2:    String_30;
     when others=>
       Char_Comp_1,
       Char_Comp_2:      Character;
     end case;
   end record;

end Global_Def;


  with Global_Def;
  use Global_Def;

package Pack_1 is
-------------

 procedure Proc_0;
 procedure Proc_1 (Pointer_Par_In:   in      Record_Pointer);
 procedure Proc_2 (Int_Par_In_Out:   in out  One_To_Fifty);
 procedure Proc_3 (Pointer_Par_Out:  out     Record_Pointer);

 Int_Glob:          integer;

end Pack_1;


with Global_Def;
use Global_Def;

package Pack_2 is
--------------

  procedure Proc_6  (Enum_Par_In:        in      Enumeration;
                     Enum_par_out:       out     Enumeration);

  procedure Proc_7  (Int_Par_In_1,
                     Int_Par_In_2:       in      One_To_Fifty;
                     Int_Par_Out:        out     One_To_Fifty);
  procedure Proc_8  (Array_Par_In_Out_1: in out  Array_1_Dim_Integer;
                     Array_Par_In_Out_2: in out  Array_2_Dim_Integer;
                     Int_Par_In_1,
                     Int_Par_In_2:       in      integer);
  function Func_1   (Char_Par_In_1,
                     Char_Par_In_2:      in      Capital_Letter)
                                                   return Enumeration;

  function Func_2   (String_Par_In_1,
                     String_Par_In_2:    in      String_30)
                                                   return boolean;

end Pack_2;


with Global_Def,pack_1;
use Global_Def;

procedure Dhrystone is
--------------
begin
  Pack_1.Proc_0; -- Proc_0 is actually the main program, but it is part
                -- of a package, and a program within a package can
                -- not be designated as the main program for execution.
                -- Therefore Proc_0 is activated by  a call from "Main".

end Dhrystone;

with Global_Def,Pack_2;
use Global_Def;

package body Pack_1 is
-----------

  Bool_Glob:         boolean;
  Char_Glob_1,
  Char_Glob_2:       character;
  Array_Glob_1:      Array_1_dim_Integer;
  Array_Glob_2:      Array_2_Dim_Integer;
  Pointer_Glob,
  Pointer_Glob_Next:    Record_Pointer;

  procedure Proc_4;
  procedure Proc_5;

procedure Proc_0
is
  Int_Loc_1,
  Int_Loc_2,
  Int_Loc_3:     One_To_Fifty;
  Char_loc:      character;
  Enum_Loc:      Enumeration;
  String_Loc_1,
  String_Loc_2: String_30;
begin

  -- Initializations

  Pack_1.Pointer_Glob_Next:=new Record_type;

  Pack_1.Pointer_glob:= new Record_Type
                        '(
                        Pointer_comp =>Pack_1.Pointer_Glob_next,
                        Discr        =>Ident_1,
                        Enum_Comp    =>Ident_3,
                        Int_Comp     =>40,
                        String_Comp  =>"DHRYSTONE PROGRAM, SOME STRING"
                      );

  String_Loc_1 :="DHRYSTONE PROGRAM, 1'ST STRING";

-----------------
-- Start timer --
-----------------

for loop_count in 1 .. 10000 loop
  Proc_5;
  Proc_4;
   --Char_Glob_1'A',Char_Glob_2='B',Bool_Glob=false
  int_Loc_1:=2;
  int_Loc_2:=3;
  String_Loc_2:="DHRYSTONE PROGRAM, 2'ND STRING";
  Enum_Loc:=Ident_2;
  Bool_Glob :=not Pack_2.Func_2(String_Loc_1,String_Loc_2);
   --Bool_Glob=true
  while Int_Loc_1<Int_Loc_2 loop --loop body executed once
   Int_Loc_3:=5*Int_Loc_1-Int_Loc_2;
    --Int_Loc_3=7
   Pack_2.Proc_7(Int_Loc_1,Int_Loc_2,Int_Loc_3);
    -- Int_Loc_3=7
   Int_Loc_1:=Int_Loc_1+1;
  end loop;
   --Int_Loc_1=3
  Pack_2.Proc_8(Array_Glob_1,Array_Glob_2,Int_Loc_1,Int_Loc_3);
   --Int_Glob=5
  Proc_1(Pointer_Glob);
  for Char_Index in 'A'..Char_Glob_2 loop--loop body executed twice
   if Enum_Loc=Pack_2.Func_1 (Char_Index,'C')
   then--not executed
     Pack_2.Proc_6(Ident_1,Enum_Loc);
   end if;
  end loop;
   --Enum_Loc=Ident_1
   --Int_Loc_1=3,Int_Loc_2=3,Int_Loc_3=7
  Int_Loc_3:=Int_Loc_2*Int_Loc_1;
  Int_Loc_2:=Int_Loc_3/Int_Loc_1;
  Int_Loc_2:=7*(Int_Loc_3-Int_Loc_2)-Int_Loc_1;
  Proc_2(Int_Loc_1);
end loop;

----------------
-- Stop timer --
----------------

end Proc_0;

procedure Proc_1(Pointer_Par_In:in Record_pointer)
is--executed once
  Next_Record:Record_Type
  renames Pointer_Par_In.Pointer_Comp.all;--=Pointer_Glob_Next.all
begin
  Next_Record:=Pointer_Glob.all;
  Pointer_Par_In.Int_Comp:=5;
  Next_Record.Int_Comp:=Pointer_Par_In.Int_Comp;
  Next_Record.Pointer_Comp:=Pointer_Par_In.Pointer_comp;
  Proc_3(Next_Record.Pointer_Comp);
    -- Next_Record.Pointer_Comp=Pointer_Glob.Pointer_Comp=Pointer_Glob_Next
  if Next_Record.Discr=Ident_1
  then -- executed
    Next_Record.Int_Comp:=6;
    Pack_2.Proc_6(Pointer_Par_In.Enum_Comp,Next_Record.Enum_Comp);
    Next_Record.Pointer_Comp:=Pointer_Glob.Pointer_Comp;
    Pack_2.Proc_7(Next_record.Int_Comp,10,Next_Record.Int_comp);
  else -- not executed
    Pointer_Par_In.all:=Next_record;
  end if;
end Proc_1;

procedure Proc_2(Int_par_In_Out: in out One_To_Fifty)
is -- executed once
   -- In_Par_In_Out=3,becomes 7
  Int_Loc:One_To_Fifty;
  Enum_Loc:Enumeration;
begin
  Int_Loc:=Int_Par_In_Out+10;
  loop -- executed once
    if Char_Glob_1='A'
    then -- executed
     Int_Loc:=Int_Loc-1;
     Int_Par_In_Out:=Int_Loc-Int_Glob;
     Enum_Loc:=Ident_1;
   end if;
  exit when Enum_Loc=Ident_1;  -- true
  end loop;
end Proc_2;

procedure Proc_3(Pointer_Par_Out:out Record_Pointer)
is -- executed once
   -- Pointer_Par_Out becomes Pointer_Glob
begin
  if Pointer_Glob/=null
  then -- executed
   Pointer_Par_Out:=Pointer_Glob.Pointer_Comp;
  else -- not executed
   Int_Glob:=100;
  end if;
  Pack_2.Proc_7(10,Int_Glob,Pointer_Glob.Int_Comp);
end Proc_3;

procedure Proc_4 -- without parameters
is -- executed once
  Bool_Loc:boolean;
begin
  Bool_Loc:=Char_Glob_1='A';
  Bool_Loc:=Bool_Loc or Bool_Glob;
  Char_Glob_2:='B';
end Proc_4;

procedure Proc_5--without parameters
is--executed once
begin
  Char_Glob_1:='A';
  Bool_Glob:=false;
end Proc_5;

end Pack_1;

with Global_Def,Pack_1;
use Global_Def;

package body Pack_2 is
------------------
function Func_3 (Enum_Par_In:in Enumeration) return boolean;
        -- forward declaration

procedure Proc_6 (Enum_Par_In:   in  Enumeration;
                  Enum_Par_out:  out Enumeration)
is -- executed once
   -- Enum_Par_In=Ident_3,Enum_Par_Out becomes Ident_2
begin
  Enum_Par_Out:=Enum_par_In;
  if not Func_3(Enum_Par_in)
  then -- not executed
    Enum_Par_Out:=Ident_4;
  end if;
  case Enum_Par_In is
   when Ident_1=>Enum_Par_out:=Ident_1;
   when Ident_2=>if Pack_1.Int_Glob>100
                 then Enum_Par_Out:=Ident_1;
                 else Enum_Par_Out:=Ident_4;
                 end if;
   when Ident_3=>Enum_Par_Out:=Ident_2; -- executed
   when Ident_4=>null;
   when Ident_5=>Enum_Par_Out:=Ident_3;
   end case;
  end Proc_6;
  procedure Proc_7(Int_par_In_1,
                   Int_Par_In_2: in  One_To_Fifty;
                   Int_Par_Out:  out One_To_Fifty)
  is -- executed three times
     -- first call: Int_Par_In_1=2,Int_Par_In_2=3,
     --             Int_Par_Out becomes 7
     -- second call:Int_Par_In_1=6,Int_Par_In_2=10,
     --             Int_Par_Out becomes 18
     -- third call: Int_Par_In_1=10,Int_Par_In_2=5,
     --             Int_Par_Out becomes 17
  Int_Loc:One_To_Fifty;
begin
  Int_Loc:=Int_Par_In_1+2;
  Int_Par_Out:=Int_Par_In_2+Int_Loc;
end Proc_7;
procedure Proc_8(Array_Par_In_Out_1:in out Array_1_Dim_Integer;
                 Array_Par_In_Out_2:in out Array_2_Dim_Integer;
                 Int_Par_In_1,
                 Int_Par_In_2:      in     integer)
is -- executed once
   -- Int_Par_In_1=3
   -- Int_Par_In_2=7
 Int_loc:One_To_Fifty;
begin
 Int_Loc:=Int_Par_In_1+5;
 Array_Par_In_Out_1(Int_Loc):=Int_Par_In_2;
 Array_Par_In_Out_1(Int_Loc+1):=
                        Array_Par_In_Out_1(Int_Loc);
 Array_Par_In_Out_1(Int_Loc+30):=Int_Loc;
 for Int_Index in Int_Loc..Int_Loc+1 loop -- loop body executed twice
   Array_Par_In_Out_2(Int_Loc,Int_Index):=Int_Loc;
 end loop;
 Array_Par_In_Out_2(Int_Loc,Int_Loc-1):=
                        Array_Par_In_out_2(Int_Loc,Int_Loc-1)+1;
 Array_Par_In_Out_2(Int_Loc+20,Int_Loc):=
                        Array_Par_In_Out_1(Int_Loc);
 Pack_1.Int_Glob:=5;
end Proc_8;

function Func_1(Char_Par_In_1,
                Char_Par_In_2:in Capital_Letter)
                                               return Enumeration
is -- executed three times,returns Ident_1 each time
   -- first call:  Char_Par_In_1='H', Char_Par_In_2='R'
   -- second call: Char_Par_In_1='A', Char_Par_In_2='C'
   -- third call : Char_Par_In_1='B', Char_Par_In_2='C'
 Char_Loc_1,Char_Loc_2:Capital_Letter;
begin
  Char_Loc_1:=Char_Par_In_1;
  Char_Loc_2:=Char_Loc_1;
  if Char_Loc_2/=Char_Par_In_2
  then--executed
    return Ident_1;
  else--not executed
    return Ident_2;
  end if;
  end Func_1;
function Func_2(String_Par_In_1,
                String_Par_In_2:in String_30)return boolean
is -- executed once,returns false
   -- String_Par_In_1="DHRYSTONE, 1'ST STRING"
   -- String_Par_IN_2="DHRYSTONE, 2'ND STRING"
   Int_Loc:  One_To_Thirty;
   Char_Loc: Capital_Letter;
begin
  Int_Loc:=2;
  while Int_Loc<=2 loop -- loop body executed once
    if Func_1(String_Par_In_1(Int_Loc),
              String_Par_In_2(Int_Loc+1))=Ident_1
    then-- executed
     Char_Loc:='A';
     Int_Loc:=Int_Loc+1;
    end if;
end loop;
if Char_Loc>='W' and Char_Loc<'Z'
then-- not executed
   Int_Loc:=7;
end if;
if Char_Loc='X'
then-- not executed
  return true;
else -- executed
  if String_Par_In_1>String_Par_In_2
  then -- executed
    Int_Loc:=Int_Loc+7;
    return true;
 else -- executed
    return false;
   end if;
  end if;
end Func_2;

function Func_3(Enum_Par_In:in Enumeration)return boolean
is -- executed once,returns true
   -- Enum_Par_In=Ident_3
 Enum_Loc:Enumeration;
begin
 Enum_Loc:=Enum_Par_In;
 if Enum_Loc=Ident_3
 then -- executed
   return true;
 end if;
end Func_3;

end Pack_2;